Warning: package 'plotly' was built under R version 4.3.2
Attaching package: 'plotly'
The following object is masked from 'package:ggplot2':
last_plot
The following object is masked from 'package:stats':
filter
The following object is masked from 'package:graphics':
layout
library(knitr)library(widgetframe)
Warning: package 'widgetframe' was built under R version 4.3.2
Loading required package: htmlwidgets
library(zoo)
Warning: package 'zoo' was built under R version 4.3.2
Attaching package: 'zoo'
The following objects are masked from 'package:base':
as.Date, as.Date.numeric
if (!file.exists("us-states.csv"))download.file(url ="https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv",destfile ="us-states.csv",method ="libcurl",timeout =60 )cv_states <- data.table::fread("https://raw.githubusercontent.com/nytimes/covid-19-data/master/us-states.csv")# load state population dataif (!file.exists("us_census_2018_population_estimates_states.csv"))download.file(url ="https://raw.githubusercontent.com/COVID19Tracking/associated-data/master/us_census_data/us_census_2018_population_estimates_states.csv",destfile ="us_census_2018_population_estimates_states.csv",method ="libcurl",timeout =60 )state_pops <- data.table::fread("https://raw.githubusercontent.com/COVID19Tracking/associated-data/master/us_census_data/us_census_2018_population_estimates_states.csv")state_pops$abb <- state_pops$statestate_pops$state <- state_pops$state_namestate_pops$state_name <-NULL### FINISH THE CODE HEREcv_states <-merge(cv_states, state_pops, by="state")
Question 2
dim(cv_states)
[1] 58094 9
head(cv_states)
state date fips cases deaths geo_id population pop_density abb
1: Alabama 2020-03-13 1 6 0 1 4887871 96.50939 AL
2: Alabama 2020-03-14 1 12 0 1 4887871 96.50939 AL
3: Alabama 2020-03-15 1 23 0 1 4887871 96.50939 AL
4: Alabama 2020-03-16 1 29 0 1 4887871 96.50939 AL
5: Alabama 2020-03-17 1 39 0 1 4887871 96.50939 AL
6: Alabama 2020-03-18 1 51 0 1 4887871 96.50939 AL
# format the datecv_states$date <-as.Date(cv_states$date, format="%Y-%m-%d")# format the state and state abbreviation (abb) variablesstate_list <-unique(cv_states$state)cv_states$state <-factor(cv_states$state, levels = state_list)abb_list <-unique(cv_states$abb)cv_states$abb <-factor(cv_states$abb, levels = abb_list)### FINISH THE CODE HERE # order the data first by state, second by datecv_states = cv_states[order(cv_states$state, cv_states$date),]# Confirm the variables are now correctly formattedstr(cv_states)
# Inspect the range values for each variable. What is the date range? The range of cases and deaths?head(cv_states)
state date fips cases deaths geo_id population pop_density abb
1: Alabama 2020-03-13 1 6 0 1 4887871 96.50939 AL
2: Alabama 2020-03-14 1 12 0 1 4887871 96.50939 AL
3: Alabama 2020-03-15 1 23 0 1 4887871 96.50939 AL
4: Alabama 2020-03-16 1 29 0 1 4887871 96.50939 AL
5: Alabama 2020-03-17 1 39 0 1 4887871 96.50939 AL
6: Alabama 2020-03-18 1 51 0 1 4887871 96.50939 AL
summary(cv_states)
state date fips cases
Washington : 1158 Min. :2020-01-21 Min. : 1.00 Min. : 1
Illinois : 1155 1st Qu.:2020-12-06 1st Qu.:16.00 1st Qu.: 112125
California : 1154 Median :2021-09-11 Median :29.00 Median : 418120
Arizona : 1153 Mean :2021-09-10 Mean :29.78 Mean : 947941
Massachusetts: 1147 3rd Qu.:2022-06-17 3rd Qu.:44.00 3rd Qu.: 1134318
Wisconsin : 1143 Max. :2023-03-23 Max. :72.00 Max. :12169158
(Other) :51184
deaths geo_id population pop_density
Min. : 0 Min. : 1.00 Min. : 577737 Min. : 1.292
1st Qu.: 1598 1st Qu.:16.00 1st Qu.: 1805832 1st Qu.: 43.659
Median : 5901 Median :29.00 Median : 4468402 Median : 107.860
Mean : 12553 Mean :29.78 Mean : 6397965 Mean : 423.031
3rd Qu.: 15952 3rd Qu.:44.00 3rd Qu.: 7535591 3rd Qu.: 229.511
Max. :104277 Max. :72.00 Max. :39557045 Max. :11490.120
NA's :1106
abb
WA : 1158
IL : 1155
CA : 1154
AZ : 1153
MA : 1147
WI : 1143
(Other):51184
min(cv_states$date)
[1] "2020-01-21"
max(cv_states$date)
[1] "2023-03-23"
Question 4
# Add variables for new_cases and new_deaths:for (i in1:length(state_list)) { cv_subset =subset(cv_states, state == state_list[i]) cv_subset = cv_subset[order(cv_subset$date),]# add starting level for new cases and deaths cv_subset$new_cases = cv_subset$cases[1] cv_subset$new_deaths = cv_subset$deaths[1]### FINISH THE CODE HEREfor (j in2:nrow(cv_subset)) { cv_subset$new_cases[j] = cv_subset$cases[j] - cv_subset$cases[j-1] cv_subset$new_deaths[j] = cv_subset$deaths[j] - cv_subset$deaths[j-1] }# include in main dataset cv_states$new_cases[cv_states$state==state_list[i]] = cv_subset$new_cases cv_states$new_deaths[cv_states$state==state_list[i]] = cv_subset$new_deaths}# Focus on recent datescv_states <- cv_states %>% dplyr::filter(date >="2021-06-01")### FINISH THE CODE HERE# Inspect outliers in new_cases using plotlyp1 <-ggplot(cv_states, aes(x = date, y = new_cases, color = state)) +geom_smooth() +geom_point(size = .5, alpha =0.5)ggplotly(p1)
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
p1<-NULL# to clear from workspacep2<-ggplot(cv_states, aes(x = date, y = new_deaths, color = state)) +geom_smooth() +geom_point(size = .5, alpha =0.5)ggplotly(p2)
`geom_smooth()` using method = 'loess' and formula = 'y ~ x'
p2<-NULL# to clear from workspace# set negative new case or death counts to 0cv_states$new_cases[cv_states$new_cases<0] =0cv_states$new_deaths[cv_states$new_deaths<0] =0# Recalculate `cases` and `deaths` as cumulative sum of updated `new_cases` and `new_deaths`for (i in1:length(state_list)) { cv_subset =subset(cv_states, state == state_list[i])# add starting level for new cases and deaths cv_subset$cases = cv_subset$cases[1] cv_subset$deaths = cv_subset$deaths[1]### FINISH CODE HEREfor (j in2:nrow(cv_subset)) { cv_subset$cases[j] = cv_subset$new_cases[j] + cv_subset$new_cases[j-1] cv_subset$deaths[j] = cv_subset$new_deaths[j] + cv_subset$new_deaths[j-1] }# include in main dataset cv_states$cases[cv_states$state==state_list[i]] = cv_subset$cases cv_states$deaths[cv_states$state==state_list[i]] = cv_subset$deaths}# Smooth new countscv_states$new_cases = zoo::rollmean(cv_states$new_cases, k=7, fill=NA, align='right') %>%round(digits =0)cv_states$new_deaths = zoo::rollmean(cv_states$new_deaths, k=7, fill=NA, align='right') %>%round(digits =0)# Inspect data again interactivelyp2<-ggplot(cv_states, aes(x = date, y = new_deaths, color = state)) +geom_line() +geom_point(size = .5, alpha =0.5)ggplotly(p2)
#p2=NULL
For plot P1, Florida has a strange negative new cases value on 6/4/21. Colorado and Pennsylvania had strange values at the beginning of 2022. Indiana had a negative new cases value in March of 2022. Kentucky, Nebraska, Virginia, Tennessee, Washington, and Colorado had negative values towards the end of 2022.
For plot P2, California had a negative new death cases on 6/4/21 and 8/11/21. Massachusetts had an extremely negative death cases on 3/14/22. Colorado had a negative new deaths value on 11/16/22.
After adjusting the outliers in the data set, there are no more negative new death cases on the graph. There are a few states with relatively high spikes in new death cases, but these values are plausible.
Question 5
### FINISH CODE HERE# add population normalized (by 100,000) counts for each variablecv_states$per100k =as.numeric(format(round(cv_states$cases/(cv_states$population/100000),1),nsmall=1))cv_states$newper100k =as.numeric(format(round(cv_states$new_cases/(cv_states$population/100000),1),nsmall=1))
# add a naive_CFR variable = deaths / casescv_states = cv_states %>%mutate(naive_CFR =round((deaths*100/cases),2))# create a `cv_states_today` variablecv_states_today =subset(cv_states, date==max(cv_states$date))
Part 2:
Question 6
### FINISH CODE HERE# pop_density vs. casescv_states_today %>%plot_ly(x =~pop_density, y =~cases, type ='scatter', mode ='markers', color =~state,size =~population, sizes =c(5, 70), marker =list(sizemode='diameter', opacity=0.5))
Warning: Ignoring 1 observations
Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
# filter out "District of Columbia"cv_states_today_filter <- cv_states_today %>%filter(state!="District of Columbia")# pop_density vs. cases after filteringcv_states_today_filter %>%plot_ly(x =~pop_density, y =~cases, type ='scatter', mode ='markers', color =~state,size =~population, sizes =c(5, 70), marker =list(sizemode='diameter', opacity=0.5))
Warning: Ignoring 1 observations
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
# pop_density vs. deathsper100kcv_states_today_filter %>%plot_ly(x =~pop_density, y =~deathsper100k,type ='scatter', mode ='markers', color =~state,size =~population, sizes =c(5, 70), marker =list(sizemode='diameter', opacity=0.5))
Warning: Ignoring 1 observations
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
# Adding hoverinfocv_states_today_filter %>%plot_ly(x =~pop_density, y =~deathsper100k,type ='scatter', mode ='markers', color =~state,size =~population, sizes =c(5, 70), marker =list(sizemode='diameter', opacity=0.5),hoverinfo ='text',text =~paste( paste(state, ":", sep=""), paste(" Cases per 100k: ", per100k, sep="") , paste(" Deaths per 100k: ", deathsper100k, sep=""), sep ="<br>")) %>%layout(title ="Population-normalized COVID-19 deaths (per 100k) vs. population density for US states",yaxis =list(title ="Deaths per 100k"), xaxis =list(title ="Population Density"),hovermode ="compare")
Warning: Ignoring 1 observations
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning: n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning: The following aesthetics were dropped during statistical transformation: size
ℹ This can happen when ggplot fails to infer the correct grouping structure in
the data.
ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
variable into a factor?
There does not seem to be a pattern between population density and deaths per 100k. Those with lower population densities seem to be more on the extreme ends of the deaths per 100k. The correlation changes from positive to negative at certain points of population density such as at around 100, 200, and 600 population density. The overall correlation seems to be flat or null.
Question 8
### FINISH CODE HERE# Line chart for naive_CFR for all states over time using `plot_ly()`plot_ly(cv_states, x =~date, y =~naive_CFR, color =~state, type ="scatter", mode ="lines")
Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
Warning in RColorBrewer::brewer.pal(N, "Set2"): n too large, allowed maximum for palette Set2 is 8
Returning the palette you asked for with that many colors
### FINISH CODE HERE# Line chart for Florida showing new_cases and new_deaths togethercv_states %>%filter(state=="Florida") %>%plot_ly(x =~date, y =~new_cases, type ="scatter", mode ="lines") %>%add_trace(x =~date, y =~new_deaths, type ="scatter", mode ="lines")
In September of 2021, Maine had the highest spike in naive CFR. Arkansas then has a spike about a month later. In September of 2022, there does not seem to be any spikes in naive CFR. The highest peaks happen in April and November 2022.
For the plot of new cases and new deaths in Florida, the peaks of new deaths follows the peaks of new cases.
Question 9
### FINISH CODE HERE# Map state, date, and new_cases to a matrixlibrary(tidyr)cv_states_mat <- cv_states %>%select(state, date, new_cases) %>% dplyr::filter(date>as.Date("2021-06-15"))cv_states_mat2 <-as.data.frame(pivot_wider(cv_states_mat, names_from = state, values_from = new_cases))rownames(cv_states_mat2) <- cv_states_mat2$datecv_states_mat2$date <-NULLcv_states_mat2 <-as.matrix(cv_states_mat2)# Create a heatmap using plot_ly()plot_ly(x=colnames(cv_states_mat2), y=rownames(cv_states_mat2),z=~cv_states_mat2,type="heatmap",showscale=T)
# Create a second heatmap after filtering to only include dates every other weekfilter_dates <-seq(as.Date("2021-06-15"), as.Date("2021-11-01"), by=14)cv_states_mat <- cv_states %>%select(state, date, newper100k) %>%filter(date %in% filter_dates)cv_states_mat2 <-as.data.frame(pivot_wider(cv_states_mat, names_from = state, values_from = newper100k))rownames(cv_states_mat2) <- cv_states_mat2$datecv_states_mat2$date <-NULLcv_states_mat2 <-as.matrix(cv_states_mat2)# Create a heatmap using plot_ly()plot_ly(x=colnames(cv_states_mat2), y=rownames(cv_states_mat2),z=~cv_states_mat2,type="heatmap",showscale=T)
For the new cases heat map, the states that stand out are Florida and California in January. They had the highest new cases during this time period.
For the new cases per 100k heat map, all the states have a turqoise to yellow color. Rhode Island seems to have the highest new cases per 100k. Wisconsin and Alaska also have relatively high new cases per 100k.
When filtering the date by every two weeks, it is clearer which states had the highest new cases per 100k. During October, Alaska had the highest new cases per 100k. During August, Louisiana and Mississippi had the highest.
Question 10
### For specified datepick.date ="2021-10-15"# Extract the data for each state by its abbreviationcv_per100 <- cv_states %>%filter(date==pick.date) %>%select(state, abb, newper100k, cases, deaths) # select datacv_per100$state_name <- cv_per100$statecv_per100$state <- cv_per100$abbcv_per100$abb <-NULL# Create hover textcv_per100$hover <-with(cv_per100, paste(state_name, '<br>', "Cases per 100k: ", newper100k, '<br>', "Cases: ", cases, '<br>', "Deaths: ", deaths))# Set up mapping detailsset_map_details <-list(scope ='usa',projection =list(type ='albers usa'),showlakes =TRUE,lakecolor =toRGB('white'))# Make sure both maps are on the same color scaleshadeLimit <-125# Create the mapfig <-plot_geo(cv_per100, locationmode ='USA-states') %>%add_trace(z =~newper100k, text =~hover, locations =~state,color =~newper100k, colors ='Purples' )fig <- fig %>%colorbar(title =paste0("Cases per 100k: ", pick.date), limits =c(0,shadeLimit))fig <- fig %>%layout(title =paste('Cases per 100k by State as of ', pick.date, '<br>(Hover for value)'),geo = set_map_details )fig_pick.date <- fig################ Map for today's date# Extract the data for each state by its abbreviationcv_per100 <- cv_states_today %>%select(state, abb, newper100k, cases, deaths) # select datacv_per100$state_name <- cv_per100$statecv_per100$state <- cv_per100$abbcv_per100$abb <-NULL# Create hover textcv_per100$hover <-with(cv_per100, paste(state_name, '<br>', "Cases per 100k: ", newper100k, '<br>', "Cases: ", cases, '<br>', "Deaths: ", deaths))# Set up mapping detailsset_map_details <-list(scope ='usa',projection =list(type ='albers usa'),showlakes =TRUE,lakecolor =toRGB('white'))# Create the mapfig <-plot_geo(cv_per100, locationmode ='USA-states') %>%add_trace(z =~newper100k, text =~hover, locations =~state,color =~newper100k, colors ='Purples' )fig <- fig %>%colorbar(title =paste0("Cases per 100k: ", Sys.Date()), limits =c(0,shadeLimit))fig <- fig %>%layout(title =paste('Cases per 100k by State as of', Sys.Date(), '<br>(Hover for value)'),geo = set_map_details )fig_Today <- fig### Plot together subplot(fig_pick.date, fig_Today, nrows =2, margin = .05)
Compared to today, the map for October 15, 2021 shows higher cases per 100k. The difference is the most apparent for Alaska, Idaho, Montana, Wyoming, North Dakota, and West Virginia. The map of today shows that in most states, the cases per 100k are less than 10.